home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
unixport
/
init_kcl.proto
< prev
next >
Wrap
Lisp/Scheme
|
1986-09-25
|
3KB
|
66 lines
(in-package "COMPILER")
(in-package "SYSTEM")
(in-package "USER")
(in-package "LISP")
(in-package "USER")
(progn (allocate 'cons 100) (allocate 'string 40)
(system:init-system) (gbc t)
(load #"../cmpnew/cmpmain.lsp") (gbc t) (load #"../cmpnew/lfun_list.lsp")
(gbc t) (load #"../cmpnew/cmpopt.lsp") (gbc t)
(defun compile-file
(&rest system::args &aux (*print-pretty* nil) (*package* *package*))
(compiler::init-env) (apply 'compiler::compile-file1 system::args))
(defun compile (&rest system::args &aux (*print-pretty* nil))
(apply 'compiler::compile1 system::args))
(defun disassemble (&rest system::args &aux (*print-pretty* nil))
(apply 'compiler::disassemble1 system::args))
(setf (symbol-function 'si:clear-compiler-properties)
(symbol-function 'compiler::compiler-clear-compiler-properties))
(load "../lsp/setdoc.lsp")
(setq system::*old-top-level* (symbol-function 'system:top-level))
(defun system::kcl-top-level nil
(when (> (system:argc) 1)
(setq system:*system-directory* (system:argv 1)))
(when (>= (system:argc) 5)
(let ((system::*quit-tag* (cons nil nil))
(system::*quit-tags* nil) (system::*break-level* '())
(system::*break-env* nil) (system::*ihs-base* 1)
(system::*ihs-top* 1) (system::*current-ihs* 1)
(*break-enable* nil))
(system:error-set
'(let ((system::flags (system:argv 4)))
(setq system:*system-directory*
(pathname (system:argv 1)))
(compile-file (system:argv 2) :output-file
(system:argv 3) :o-file
(case (schar system::flags 1) (#\0 nil) (#\1 t)
(t (system:argv 5)))
:c-file
(case (schar system::flags 2) (#\0 nil) (#\1 t)
(t (system:argv 6)))
:h-file
(case (schar system::flags 3) (#\0 nil) (#\1 t)
(t (system:argv 7)))
:data-file
(case (schar system::flags 4) (#\0 nil) (#\1 t)
(t (system:argv 8)))
:system-p
(if (char-equal (schar system::flags 0) #\S) t
nil))))
(bye (if compiler::*error-p* 1 0))))
(format t "KCl (Kyoto Common Lisp) ~A~%" "WHAT VERSION?")
(in-package 'system::user) (incf system::*ihs-top* 2)
(funcall system::*old-top-level*))
(defun lisp-implementation-version nil "WHAT VERSION?")
(setq si:*inhibit-macro-special* t)
(setq *modules* nil) (gbc t) (system:reset-gbc-count)
(allocate 'cons 200)
(defun system:top-level nil (system::kcl-top-level))
(unintern 'system)
(unintern 'lisp)
(unintern 'compiler)
(unintern 'user)
(system:save-system "saved_kcl") (bye)
(defun system:top-level nil (system::kcl-top-level))
(save "saved_kcl") (bye))